home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / cadence.arc / VOL1NO4.ARC / LAYER.LSP < prev    next >
Encoding:
Text File  |  1986-09-23  |  10.9 KB  |  276 lines
  1. ;(c)COPYRIGHT 1986 by CHASE SYSTEMS, all rights reserved.
  2. ;These are autoLISP programs written to run in conjunction
  3. ;with a menu system and autoCAD. Authored by Bruce Chase
  4.  
  5. ;3 autoLISP functions used by this program are not available within
  6. ; the 2.18 version of autoCAD vs. the 2.5 version.  Changes in the
  7. ; program are noted so.
  8.  
  9.  
  10.  
  11. ;This program is called LAYER.LSP and should reside on the autoCAD
  12. ; directory. This is the main program for selecting
  13. ; major-minor-basic layering group name and turning on autolayering.
  14. ; There is little need for this to be within the ACAD.LSP
  15. ; file since it will ultimately take up memory or paging space that
  16. ; is best suited for more heavily used programs.  
  17.  
  18. (apply '(lambda ( /  c x1)  ;may be deleted if you do not want local variables
  19.  (setvar "cmdecho" 0)       ;turn off screen echo
  20.  (setq c 1)                                     ;initialize cntr
  21.  (mapcar '(lambda (x y z)
  22.    (MENUCMD y)                                  ;call up screen menu with V2.5 only
  23.    (prompt "\n \n \nPick ")                     ;line feeds
  24.    (princ z)                                    ;layer "depth"
  25.    (princ" layer name: <")                      
  26.    (if (eval x) (princ (eval x)))               ;default choice
  27.    (princ "> ")(setq x1 nil)
  28.    (while (null x1)                             ;loop until choice made
  29.     (setq x1 (substr (getstring)))             ;-------NOTE 4 
  30.      (if (and (/= x1 "no chnge")(/= x1 ""))
  31.       (progn
  32.         (while (< (strlen  x1) (if (< c 3) 4 3));insure name is 4 char
  33.                   (setq x1 (strcat x1 "#")))  
  34.       (if (< c 3)(setq x1 (strcat  x1 "-")))    ;append "-" to name
  35.       (set x x1)
  36.     ))
  37.    (setq x1 (eval x)))
  38.    (setq c (+ c 1))                             ;increment counter
  39.  )
  40.  '(laymaj laymin laybas)                        ;layer depth of choice
  41.  (list "s=laymaj" "s=laymin" "s=laybas")        ;screen menus
  42.  (list "MAJOR" "MINOR" "BASIC")                 ;depth of layering
  43.  )
  44.   (setq lay (strcase (strcat laymaj laymin)))   ;string together name
  45.   (setlay laybas)                               ;set the layer to layer name
  46.   (MENUCMD "s=s")                               ;pull up new screen menu v2.5 ONLY
  47. ) '()                                           ;for apply lambda
  48. )                                               ;end defun
  49.  
  50.  
  51.  
  52.  
  53. ;THE FOLLOWING TWO DEFUNS & "SETQ" BELONG IN THE ACAD.LSP FILE
  54.  
  55. ;The following program calls up the automatic changing of layers within
  56. ; a "layer group". The automatic layering is accomplished by putting
  57. ; within the menu or LISP program, the SETLAY defun call with an argument,
  58. ; "HVY", "MED", "THN", "TXT", "DIM", "SYM"....per association list below.
  59. ; For example- (setlay "TXT") calls up the text layer of the current
  60. ; layer group. If there is not a CURRENT LAYER GROUP set with the
  61. ; LAYER program then the current layer remains current.
  62.  
  63. (defun setlay (x)(if lay (setlay2 x)))        ;This allows paging of SETLAY2
  64.                                               ; by version 2.5 only if required
  65.                                               ; without calling up the full
  66.                                               ; program if not required.
  67.  
  68. (defun setlay2 (x / c temp clr tlay xx)      ;x must be 3 letters from the
  69.                                              ; the assoc. list below
  70.   (setq xx (strcase x) lay (strcase lay))    ;USE ONLY IN VERSION 2.5
  71.                                              ; converts input to upper case.
  72.                                              ; With version 2.18
  73.                                              ; input must be upper case.
  74.   (setq temp (assoc x '(                     ;temp is a number to call up color
  75.      ("HVY" 0)("MED" 1)("THN" 2)("DIM" 3)    ; from the "CLAY" setq in ACAD.LSP
  76.      ("SYM" 4)("TXT" 5)("HAT" 6)             ;CAR is prefix for autoLAYER call
  77.      ("BOR" 7 "BORDER")("CEN" 8 "CENTER")("DDT" 9 "DASHDOT") ;CADDR is linetype call
  78.      ("DSH" 10 "DASHED")("DIV" 11 "DIVIDE")("DOT" 12 "DOT")
  79.      ("HDN" 13 "HIDDEN")("PHM" 14 "PHANTOM"))))
  80.  (if temp (progn                             ;sets layer, color and linetype
  81.    (setq clr (if (and clay (setq c (nth (cadr temp) clay))) c 7))
  82.    (cond ((and layl (cadr temp))(commad "linetype" (caddr temp) "color" clr))
  83.          ((and lay temp)
  84.           (command "layer" "t" (setq tlay (strcat lay (car temp)))
  85.                   "n" tlay "s" tlay;----------------------------NOTE 3 
  86.                   "c" clr  tlay    
  87.                   "lt" (if (> (cadr temp) 6) (caddr temp) "CONTINUOUS") tlay
  88.         "")))                         ;end cond
  89.     )                                 ;end progn 
  90.     (prompt "\nImproper autoLAYER suffix ") ;catch-all for improper (setlay "XXXX")
  91.  )                                    ;end if statement
  92. )
  93.  
  94. ;The following SETQ lists the color numbers in order of the association list
  95. ; above. This allows changeable layer colors by merely changing this SETQ.
  96. ; With some handy programming you may devise a program that asks the user for
  97. ; a specific color for a layer type, and that color or color number may be
  98. ; written to file, and called upon whenever autolayering is invoked. You may
  99. ; choose your own color number in the following SETQ to change the colors
  100. ; if you don't want to do that type of programming. Remember, the numbers
  101. ; relate to the above assoc. list. Therefor- "HVY" layer is RED (1),
  102. ; "MED" is CYAN (4) and so forth.
  103.  
  104. (setq clay (list 1 4 6 5 2 4 3 3 3 3 3 3 3 3 3 ))
  105.  
  106.  
  107. ;--------------------------------------END DEFUNS & SETQ FOR ACAD.LSP FILE
  108.  
  109.  
  110.  
  111. ;LAYER2.LSP program
  112. ;This program allows for freezing, thawing, on, off etc
  113. ; of layers on a major, minor, or basic tiered level and is used
  114. ; in conjunction with the screen menus below. 
  115.  
  116. (apply '(lambda ( /  name x names temp)
  117.   (setvar "cmdecho" 0)
  118.   (MENUCMD (strcat "s=" (cadr x)))              ;call up screen menu V2.5 ONLY
  119.   (setq name 1 names "")                        ;initialize values
  120.   (prompt "\n \n \nPick ")
  121.   (princ (caddr x))
  122.   (princ " to ")
  123.   (princ (car x)) 
  124.   (while name 
  125.      (if (/= names "")(progn 
  126.        (princ "\nNames selected: ")
  127.        (princ names)))
  128.      (setq name (getstring "\n Pick from screen menu: <none> "))
  129.      (if (or (= name "none")(= name ""))(setq name nil))
  130.      (if name (progn 
  131.         (setq name (cond ((= (cadr x)"laymaj")(strcat name "*"))
  132.                  ((= (cadr x)"laymin")(strcat "????-" name "*"))  
  133.                      ((= (cadr x)"laybas")(strcat "????-????-" name))
  134.              (t (quit))
  135.                )                            ;end cond
  136.     )                                       ;end setq
  137.         (setq names (if (= names "") name (strcat names "," name)))
  138.        ))                                       ;end progn and if
  139.     (if (= (car x) "set")(setq name nil))
  140.   )                                             ;end while
  141.   (if lay (progn
  142.      (prompt "\n \nThe current LAYER GROUP is ")
  143.      (princ lay)
  144.      (setq temp (substr (getstring          ;----------------------- NOTE 2
  145.       "  Keep it current? <yes> ")))        ;----------------------- NOTE 2
  146.      (if (or (= temp "n")(= temp "N"))      ;------------------------NOTE 2
  147.         (setq laymaj nil laymin nil lay nil)) ;--------------------- NOTE 2
  148.   ))                                         
  149.    (command "layer" )
  150.    (command "t" 0 "s" 0 (car x) names "t" (if lay lay ""))
  151.    (if (and laybas lay)(command "n" (setq temp (strcat lay laybas));--NOTE 1
  152.                                 "s" temp "");-------------------------NOTE 1
  153.         (command "")) ;-----------------------------------------------NOTE 1
  154.    (MENUCMD "s=s")                     ;call up your default screen menu V2.5 ONLY
  155. ) '())
  156.  
  157.  
  158. ;------------------SCREEN MENUS------------
  159. ;You must put these into your menu. The last 3 screen menus may be changed to
  160. ;your layer name liking. If you change the 1st one, make sure you follow
  161. ;through with all necessary changes on the LAYER2 program.  
  162. ;all $s=xxxxxxx are for version 2.18 only- you may delete the screen menu
  163. ;calls with version 2.5 since the programs call up the screen menus as needed.
  164.  
  165. **laysystem
  166. [autoLAYR]^c^c^c(load "layer")
  167. [Set BSIC]^c^c(setq x '("set" "laybas" "BASIC group")) (load "layer2")
  168. [Choose:]
  169. [ Freeze]
  170. [  *----]^c^c(setq x '("freeze" "laymaj" "MAJOR group")) $s=laymaj (load "layer2")
  171. [  ?-*--]^c^c(setq x '("freeze" "laymin" "MINOR group")) $s=laymin (load "layer2")
  172. [  ?-?-*]^c^c(setq x '("freeze" "laybas" "BASIC group")) $s=laybas (load "layer2")
  173. [ Thaw] 
  174. [  *----]^c^c(setq x '("thaw" "laymaj" "MAJOR group")) $s=laymaj (load "layer2")
  175. [  ?-*--]^c^c(setq x '("thaw" "laymin" "MINOR group")) $s=laymin (load "layer2")
  176. [  ?-?--]^c^c(setq x '("thaw" "laybas" "BASIC group")) $s=laybas (load "layer2")
  177.  
  178. [ Off]
  179. [  *----]^c^c(setq x '("Off" "laymaj" "MAJOR group")) $s=laymaj (load "layer2")
  180. [  ?-*--]^c^c(setq x '("Off" "laymin" "MINOR group")) $s=laymin (load "layer2")
  181. [  ?-?-*]^c^c(setq x '("Off" "laybas" "BASIC group")) $s=laybas (load "layer2")
  182. [ On] 
  183. [  *----]^c^c(setq x '("On" "laymaj" "MAJOR group")) $s=laymaj (load "layer2")
  184. [  ?-*--]^c^c(setq x '("On" "laymin" "MINOR group")) $s=laymin (load "layer2")
  185. [  ?-?--]^c^c(setq x '("On" "laybas" "BASIC group")) $s=laybas (load "layer2")
  186.  
  187. **LAYMAJ
  188. [Off](progn (setq laymaj nil lay nil laymin nil)(princ))
  189.  
  190. [SITE]SITE $s=laymin
  191. [FLR0]FLR0 $s=laymin
  192. [FLR1]FLR1 $s=laymin
  193. [FLR2]FLR2 $s=laymin
  194. [FLR3]FLR3 $s=laymin
  195. [ELV1]ELV1 $s=laymin
  196. [ELV2]ELV2 $s=laymin
  197. [PLM0]PLM0 $s=laymin
  198. [PLM1]PLM1 $s=laymin
  199. [ELC0]ELC0 $s=laymin
  200. [ELC1]ELC1 $s=laymin
  201. [ELC2]ELC2 $s=laymin
  202. [HVC0]HVC0 $s=laymin
  203. [HVC1]HVC1 $s=laymin
  204. [HVC2]HVC2 $s=laymin
  205. [NOTE]NOTE $s=laymin
  206.  
  207. [--LAST--]^C^C^C $s=
  208.  
  209. **LAYMIN
  210.  
  211.  
  212. [CABT]CABT $s=laybas
  213. [FURN]FURN $s=laybas
  214. [PLUM]PLUM $s=laybas
  215. [TOFF]TOFF $s=laybas
  216. [NOTE]NOTE $s=laybas
  217. [ELEV]ELEV $s=laybas
  218. [ELEC]ELEC $s=laybas
  219. [PLMB]PLMB $s=laybas
  220. [HVAC]HVAC $s=laybas
  221. [REFL]REFL $s=laybas
  222. [STRC]STRC $s=laybas
  223. [COVR]COVR $s=laybas
  224. [MIS1]MIS1 $s=laybas
  225. [MIS2]MIS2 $s=laybas
  226. [MIS3]MIS3 $s=laybas
  227. [NOTE]NOTE $s=laybas
  228.  
  229. [--LAST--]$s=
  230.  
  231. **laybas
  232.  
  233. [DIM]DIM $s=s
  234. [TXT]TXT $s=s
  235. [SYM]SYM $s=s
  236. [HAT]HAT $s=s
  237.  
  238. [LINE-CON] $s=s
  239. [  HVY]HVY $s=s
  240. [  MED]MED $s=s
  241. [  THN]THN $s=s
  242.  
  243. [OTHER]
  244. [ CEN]CEN $s=s
  245. [ DDT]DDT $s=s
  246. [ DOT]DOT $s=s
  247. [ DSH]DSH $s=s
  248. [ HDN]HDN $s=s
  249. [ PHN]PHN $s=s
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  
  260. ;--------------NOTES-------------------------------------------------
  261. *NOTE 1- You may substitute the following lines if you have version 2.5
  262.       of autoCAD:
  263.    (if (and laybas lay)(command "M" (strcat lay laybas) "")(command ""))
  264.  
  265. *NOTE 2- The "strcase" lisp function available with version 2.5 allows:
  266.      (setq temp (strcase (substr (getstring
  267.          "  Keep it current? <yes> ") 1 1)))
  268.      (if (= temp "N")(setq laymaj nil laymin nil lay nil))
  269.  
  270. *NOTE 3- With version 2.5 of autoCAD, substitute:
  271.           "M" tlay 
  272.  
  273. *NOTE 4- With version 2.5 of autoCAD, substitute:
  274.      (setq x1 (strcase (substr (getstring) 1 4)))
  275.  
  276.